perm filename BDISP.F4[JC,MUS] blob sn#084712 filedate 1974-01-30 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
C00004 00003		IY=AMP(1)*100.+300.
C00006 00004		CALL ALINE(-400,0,100,0)
C00008 00005		GO TO 60
C00010 00006	102	NC=NC+1
C00011 ENDMK
CāŠ—;
	SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
	DIMENSION XFREQ(2)
	COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
	CALL DPYTYP(-400,6,1)
302	TYPE 303
303	FORMAT(' CR OR 1 TO CHANGE AMP FUNC'/)
	ACCEPT 304,IFUN
304	FORMAT(I)
	GO TO (305,306),IFUN+1
306	TYPE 310
310	FORMAT(' NOW AMPLITUDE FUNCTION'/)
	CALL GEN(AMP)
305	MIBASE=99999
	TYPE 4077
4077	FORMAT(' TYPE SCALE FACT FOR AMP OR CR FOR NO CHANGE'/)
	ACCEPT 702,XSKALE
	IF(XSKALE.EQ.0.0)GO TO 4078
	SKALE=XSKALE
4078	MIFREQ=-400
309	NND=ZZND
	TYPE 4001,NND
4001	FORMAT('+NO OF LINES/100 (TIME SLICES) MINUS BOUNDS=',I7/)
	TYPE 103
103	FORMAT('+TYPE CR OR -1 FOR NONE OR NEW NUMBER OF LINES/100='/)
	ACCEPT 702,XXND
	IF(XXND.NE.0.0)ZZND=XXND
	IF(XXND.LT.0.0)ND=0
	IF(XXND.GT.0.0)ND=100./(XXND+1.)
	TYPE 4003,SCALE
4003	FORMAT('+SCALE NOW =',F7.1/)
	TYPE 700
700	FORMAT('+TYPE CR OR DISPLAY SCALE='/)
	ACCEPT 702,SCAL
	IF(SCAL.NE.0.0)SCALE=SCAL
702	FORMAT(F)
104	FORMAT (I)
	CALL DPYSET(1,IJJ,4000)
	CALL CLRPOG(1)
	CALL DPYBIG(5)
	CALL DPYTXT(-300,450,'DYNAMIC FM SPECTRUM',4)
	CALL ALINE(-400,300,-200,300)
	CALL ALINE(-400,400,-400,300)
	CALL DPYBIG(1)
	CALL DPYTXT(-380,280,'AMP FUNCTION',3)
	CALL DPYTXT(-440,400,'1.0',1)



	IY=AMP(1)*100.+300.
	IX=-400
	CALL AIVECT(IX,IY)
	DO 401 I=2,100
	IX=IX+2
	IY=AMP(I)*100.+300.
401	CALL AVECT(IX,IY)
	CALL ALINE(100,300,300,300)
	CALL ALINE(100,400,100,300)
	CALL DPYTXT(120,280,'INDEX FUNCTION',3)
	CALL DPYTXT(30,400,'IDX2=',1)
	CALL DPYTXT(30,300,'IDX1=',1)
	IY=AMP(1)*100.+300.
	IX=100
	CALL AIVECT(IX,IY)
	DO 402 I=2,100
	IY=FUNC(I)*100.+300.
	IX=IX+2
402	CALL AVECT(IX,IY)
	CALL DPYBIG(3)
71	FORMAT(A5)
	CALL DPYTXT(-400,-300,'CAR=',1)
	XCAR=ZCAR
	ENCODE(5,72,XXCAR)XCAR
72	FORMAT(F5.1)
	CALL DPYTXT(-360,-300,XXCAR,1)
	CALL DPYTXT(-400,-320,'MOD=',1)
	XCAR=ZMOD
	ENCODE(5,72,XXCAR)XCAR
	CALL DPYTXT(-360,-320,XXCAR,1)
	CALL DPYTXT(-400,-340,'IDX1=',1)
	XI1T=ZZI1
	ENCODE(5,72,XXI1T)XI1T
	CALL DPYTXT(-360,-340,XXI1T,1)
	CALL DPYTXT(-400,-360,'IDX2=',1)
	XI2T=ZZI2
	ENCODE(5,72,XXI2T)XI2T
	CALL DPYTXT(-360,-360,XXI2T,1)
	CALL DPYBIG(1)
	CALL DPYTXT(60,300,XXI1T,1)
	CALL DPYTXT(60,400,XXI2T,1)
	CALL DPYBIG(3)
	CALL ALINE(-400,0,100,0)
	CALL ALINE(100,0,90,5)
	CALL ALINE(100,0,90,-5)
	CALL ALINE(-400,250,-400,0)
	CALL ALINE(-400,250,-395,240)
	CALL ALINE(-400,250,-405,240)
	CALL DPYTXT(-480,250,'Amp',1)
	CALL DPYBIG(1)
	CALL DPYTXT(-480,0,'0 Hz',1)
	CALL DPYBIG(3)
	CALL DPYTXT(115,0,'Time',1)
	IX=-400
	IY=-90
	M=10
	CALL DPYTXT(IX,IY,'F',1)
	IX=IX+M
	IY=IY-M
	CALL DPYTXT(IX,IY,'r',1)
	IX=IX+M
	IY=IY-M
	CALL DPYTXT(IX,IY,'e',1)
	IX=IX+M
	IY=IY-M
	CALL DPYTXT(IX,IY,'q',1)
	MAX=FREQ(1,50,1)
	DO 200 J=0,MAX
	KL=1
50	IF(FREQ(1,J,KL).EQ.99999.)GO TO 100
C	IF((FREQ(1,J,KL).EQ.0.0).AND.(FREQ(3,J,KL).EQ.0.0))GO TO 100
	IX=ABS(FREQ(1,J,KL))*SCALE-400.
	ZZ=IX
	IY=(ZZ+400.)*(-1.)+250.*FREQ(2,J,KL)*AMP(1)*SKALE
	BASE=(ZZ+400.)*(-1.)
	IBASE=BASE
	IF(MIBASE.GT.IBASE)MIBASE=IBASE
	CALL DPYBIG(1)
	IF(FREQ(3,J,KL).NE.0.0)GO TO 51
	CALL DPYTXT(IX-40,IBASE,'car',1)
	GO TO 60
51	ZFREQ=FREQ(1,J,KL)
	ENCODE(7,52,XFREQ)ZFREQ
52	FORMAT(F7.2)
	CALL DPYTXT(IX-60,IBASE,XFREQ,2)
	GO TO 60
100	KL=KL+1
	IF(KL.GE.100)GO TO 200
	GO TO 50
60	CALL AIVECT(IX,IBASE)
	IFREQ=IX
	IF(MIFREQ.LT.IFREQ)MIFREQ=IFREQ
	DO 61 NO=1,25
	CALL SVECT(5,0)
61	CALL SIVECT(15,0)
 	IF(KL.NE.1)IX=IX+(KL-1)*5
	CALL AIVECT(IX,IBASE)
	IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
 	IF(FREQ(2,J,KL).NE.0.0)CALL AVECT(IX,IY)
30	CONTINUE
	IF(ND.EQ.0)GO TO 36
	NC=KL
	IF(NC.LE.ND)GO TO 36
31	NC=NC-ND
	IF(NC.GT.ND)GO TO 31
36	IFLIP=1
	DO 199 KZ=KL+1,100
	IF(KL.GT.100)GO TO 199
	IF(FREQ(1,J,KZ).EQ.99999.)GO TO 199
	IX=IX+5
	IY=FREQ(2,J,KZ)*250.*AMP(KZ)*SKALE+BASE
	IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
	IF(FREQ(1,J,KZ).EQ.0.0)IFLIP=-IFLIP
	IF(IFLIP.GT.0)GO TO 2001
	CALL AIVECT(IX,IY)
	GO TO 2002
2001	CALL AVECT(IX,IY)
2002	IF(ND.EQ.0)GO TO 199
	IF(FREQ(1,J,KZ).EQ.0.0)GO TO 199
	IF(NC.LT.ND)GO TO 102
	CALL AVECT(IX,IBASE)
	CALL AIVECT(IX,IY)
102	NC=NC+1
	IF(NC.GT.ND)NC=1
199	CONTINUE
200	CONTINUE
	MIFREQ=MIFREQ+10
	MIBASE=MIBASE-10
	CALL ALINE(-400,0,MIFREQ,MIBASE)
	CALL ALINE(MIFREQ,MIBASE,MIFREQ-2,MIBASE+10)
	CALL ALINE(MIFREQ,MIBASE,MIFREQ-10,MIBASE+4)
	CALL DPYOUT(1)
	TYPE 603
603	FORMAT(' TYPE CR TO FIN'/' 1 TO CHNG AMPF'/)
	TYPE 604
604	FORMAT('+ 2 FOR VERT LINES AND SC DISP'/)
	ACCEPT 666,N
666	FORMAT(I)
	GO TO (302,305),N
	CALL HYDPOG(1)
	II(1)=IJJ(2)+2
	CALL SAVB(II)
	RETURN
	END